home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / pvt12.zip / PVTVIEW.BAS < prev    next >
BASIC Source File  |  1990-11-22  |  5KB  |  219 lines
  1. '$DYNAMIC
  2. DECLARE SUB GetPassword ()
  3. DECLARE SUB Prompts ()
  4. DECLARE SUB Crypt (PWord$)
  5. DECLARE SUB LoadFile ()
  6. DECLARE SUB FillScreen ()
  7. DECLARE SUB Browse ()
  8. DECLARE SUB PassWord ()
  9. DECLARE SUB InitScreen ()
  10. DEFINT A-Z
  11. DIM SHARED Buf$(5000)
  12. DIM SHARED fore, back, LineCnt, Top, PWord$
  13.  
  14. InitScreen
  15. LoadFile
  16. Browse
  17.  
  18. ErrorHandler:
  19.   BEEP
  20.   COLOR 7, 0: CLS
  21.   SELECT CASE ERR
  22.     CASE 14
  23.       PRINT "File too big (40k max)"
  24.     CASE 52
  25.       PRINT "Bad File Name or Number"
  26.     CASE 71
  27.       PRINT "Disk Not Ready"
  28.     CASE 76
  29.       PRINT "Path Not Found"
  30.     CASE ELSE
  31.       PRINT "Error #"; ERR
  32.       ERROR ERR
  33.   END SELECT
  34.   END
  35.  
  36. REM $STATIC
  37. SUB Browse
  38.   CLS
  39.   Top = 0
  40.   DO
  41.     FillScreen
  42.     Prompts
  43.     KeyPress$ = ""
  44.     DO
  45.       KeyPress$ = INKEY$
  46.     LOOP WHILE KeyPress$ = ""
  47.     SELECT CASE KeyPress$
  48.       CASE CHR$(0) + "H"' Up
  49.         IF Top > 0 THEN Top = Top - 1
  50.       CASE CHR$(0) + "P"' Down
  51.         IF Top < LineCnt - 23 THEN Top = Top + 1
  52.       CASE CHR$(0) + "I" ' PgUp
  53.         IF Top > 22 THEN
  54.           Top = Top - 23
  55.         ELSE
  56.           Top = 0
  57.         END IF
  58.       CASE CHR$(0) + "Q" ' PgDn
  59.         IF Top < LineCnt - 46 THEN
  60.           Top = Top + 23
  61.         ELSE
  62.           IF LineCnt > 22 THEN
  63.             Top = LineCnt - 23
  64.           ELSE
  65.             Top = 0
  66.           END IF
  67.         END IF
  68.       CASE CHR$(0) + "G" ' Home
  69.         Top = 0
  70.       CASE CHR$(0) + "O" ' End
  71.         IF LineCnt > 22 THEN
  72.           Top = LineCnt - 23
  73.         ELSE
  74.           Top = 0
  75.         END IF
  76.       CASE CHR$(27)
  77.         DEF SEG = &H50
  78.         POKE 0, 0     ' re-enable print screen
  79.         COLOR 7, 0
  80.         CLS
  81.         END
  82.       CASE ELSE
  83.         BEEP
  84.     END SELECT
  85.   LOOP
  86. END SUB
  87.  
  88. SUB Crypt (PWord$)
  89.   STATIC i, j
  90.   PRINT
  91.   PRINT "Unscrambling..."
  92.   ' calculate Xor value
  93.   xnum = 0
  94.   FOR i = 1 TO 4
  95.     xnum = xnum + (ASC(MID$(PWord$, i, 1)) * i)
  96.   NEXT
  97.   xnum = xnum MOD 256
  98.   ' crypt buffer
  99.   FOR i = 0 TO LineCnt
  100.     FOR j = 1 TO LEN(Buf$(i))
  101.       IF j MOD 2 THEN ' even/odd
  102.         MID$(Buf$(i), j, 1) = CHR$(ASC(MID$(Buf$(i), j, 1)) XOR xnum)
  103.       ELSE
  104.         MID$(Buf$(i), j, 1) = CHR$(ASC(MID$(Buf$(i), j, 1)) XOR (255 - xnum))
  105.       END IF
  106.     NEXT
  107.   NEXT
  108. END SUB
  109.  
  110. SUB FillScreen
  111.   COLOR fore, back
  112.   LOCATE 2, 1
  113.   FOR i = Top TO Top + 22
  114.     IF i > LineCnt THEN
  115.       PRINT SPACE$(80);
  116.     ELSE
  117.       PRINT LEFT$(Buf$(i) + SPACE$(80), 80);
  118.     END IF
  119.   NEXT
  120. END SUB
  121.  
  122. SUB GetPassword
  123.   PWord$ = "    "
  124.   Posn = 1
  125.   DO
  126.     LOCATE 1, 38 + Posn, 1
  127.     PKey$ = ""
  128.     DO
  129.       PKey$ = UCASE$(INKEY$)
  130.     LOOP WHILE PKey$ = ""
  131.     SELECT CASE PKey$
  132.       CASE "0" TO "9", "A" TO "Z", " "
  133.         PRINT " ";
  134.         MID$(PWord$, Posn, 1) = PKey$
  135.         Posn = Posn + 1
  136.         IF Posn > 4 THEN EXIT DO
  137.       CASE CHR$(8), CHR$(0) + "K"
  138.         IF Posn > 1 THEN
  139.           Posn = Posn - 1
  140.         ELSE
  141.           BEEP
  142.         END IF
  143.       CASE CHR$(27)
  144.         PWord$ = "    "
  145.         EXIT DO
  146.       CASE ELSE
  147.         BEEP
  148.     END SELECT
  149.   LOOP
  150.   COLOR fore, back
  151.   CLS
  152. END SUB
  153.  
  154. SUB InitScreen
  155.   CLS
  156.   ' check for color/monochrome monitor
  157.   DEF SEG = 0
  158.   IF PEEK(&H449) = 7 THEN ' monochrome
  159.     fore = 7: back = 0
  160.   ELSE 'colour
  161.     fore = 11: back = 1
  162.   END IF
  163.   DEF SEG
  164.   ' init screen
  165.   COLOR fore, back: CLS
  166.   COLOR fore, back
  167. END SUB
  168.  
  169. SUB LoadFile
  170.   COLOR fore + 16, back
  171.   LOCATE 2, 1
  172.   PRINT "loading file...";
  173.   COLOR fore, back
  174.   ON ERROR GOTO ErrorHandler
  175.   OPEN COMMAND$ FOR INPUT AS 1
  176.   INPUT #1, Buf$(0)
  177.   IF Buf$(0) = "{ePbVaT}" THEN ' Private file
  178.     BEEP
  179.     DEF SEG = &H50
  180.     POKE 0, 1     ' disable print screen
  181.     DEF SEG
  182.     CLS
  183.     PRINT "Private File! Please enter password: [xxxx]"
  184.     GetPassword
  185.     CLOSE #1
  186.     PRINT "Loading file..."
  187.     OPEN COMMAND$ FOR BINARY AS #1
  188.     Tmp$ = SPACE$(10)
  189.     GET #1, , Tmp$
  190.     LineCnt = 0
  191.     DO WHILE NOT EOF(1)
  192.       GET #1, , Length%
  193.       Buf$(LineCnt) = SPACE$(Length)
  194.       GET #1, , Buf$(LineCnt)
  195.       LineCnt = LineCnt + 1
  196.     LOOP
  197.     Crypt PWord$
  198.   ELSE
  199.     LineCnt = 1
  200.     DO WHILE NOT EOF(1)
  201.       LINE INPUT #1, Buf$(LineCnt)
  202.       IF Buf$(LineCnt) = CHR$(12) THEN Buf$(LineCnt) = " "
  203.       LineCnt = LineCnt + 1
  204.     LOOP
  205.   END IF
  206.   CLOSE 1
  207.   ON ERROR GOTO 0
  208. END SUB
  209.  
  210. SUB Prompts
  211.   COLOR back, fore
  212.   LOCATE 1, 1, 0
  213.   PRINT SPACE$(32); "< Private View >"; SPACE$(5); "v1.2 (c) 1990 Brent Ashley "
  214.   LOCATE 25, 1
  215.   PRINT " <"; CHR$(24); "> <"; CHR$(25); "> <PgUp> <PgDn> <Home> <End>"; SPACE$(34); " Esc=Quit  ";
  216.   LOCATE 1, 2: PRINT USING " Top:####/####"; Top + 1; LineCnt;
  217. END SUB
  218.  
  219.